home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 10 / AACD 10.iso / AACD / Programming / AmigaTalk / Intuition / MyGadgets.st < prev    next >
Text File  |  2000-02-16  |  10KB  |  249 lines
  1. "-------------------------------------------------------"
  2. " PushButton Class is a custom look for boolean gadgets."
  3. "-------------------------------------------------------"
  4.  
  5. Class PushButton :BoolGadget  ! renderName selectName !
  6. [
  7.    " gadgetValues is an Array with the following fields: 
  8.        NextGadget, LeftEdge, TopEdge, Width, Height, Flags,
  9.        Activation, GadgetType, GadgetText, GadgetID:
  10.    "
  11.    initialize: gadgetName withArray: gadgetValues
  12.       ! ng le te w h f a gt gr sr txt id tb1 tb2 a1 a2 a3 a4 !
  13.  
  14.       ng  <- gadgetValues at: 1.
  15.       le  <- gadgetValues at: 2.
  16.       te  <- gadgetValues at: 3.
  17.       w   <- gadgetValues at: 4.
  18.       h   <- gadgetValues at: 5.
  19.       f   <- gadgetValues at: 6.
  20.       a   <- gadgetValues at: 7.
  21.       gt  <- gadgetValues at: 8.
  22.       txt <- gadgetValues at: 9.
  23.       id  <- gadgetValues at: 10.
  24.       a1  <- Array new: 12.
  25.       a2  <- Array new: 8.
  26.       a3  <- Array new: 12.
  27.       a4  <- Array new: 8.
  28.       gr  <- Border new.
  29.       sr  <- Border new.
  30.       tb1 <- Border new.
  31.       tb2 <- Border new.
  32.       a1 at: 1 put: 0; at: 2 put: h; at: 3 put: 0; at: 4 put: 0.
  33.       a1 at: 5 put: w; at: 6 put: 0; at: 7 put: (w - 1); at: 8 put: 1.
  34.       a1 at: 9 put: 1; at: 10 put: 1; at: 11 put: 1; at: 12 put: (h - 1).
  35.       
  36.       a2 at: 1 put: 0; at: 2 put: 0; at: 3 put: 2; at: 4 put: 0.
  37.       a2 at: 5 put: 0; at: 6 put: 6; at: 7 put: a1; at: 8 put: 'NULL'.
  38.       
  39.       tb1 initialize: 'tb1' withArray: a2.
  40.  
  41.       a3 at: 1 put: w; at: 2 put: 0; at: 3 put: w; at: 4 put: h.
  42.       a3 at: 5 put: 0; at: 6 put: h; at: 7 put: 1; at: 8 put: (h - 1).
  43.       a3 at: 9 put: (w - 1); at: 10 put: (h - 1); at: 11 put: (w - 1); at: 12 put: 0.
  44.       
  45.       a4 at: 1 put: 0; at: 2 put: 0; at: 3 put: 1; at: 4 put: 0.
  46.       a4 at: 5 put: 0; at: 6 put: 6; at: 7 put: a3; at: 8 put: 'tb1'.
  47.  
  48.       gr  initialize: (gadgetName,'Bdr1') withArray: a4.
  49. "
  50.       tb2 initialize: 'tb2' withArray: #( 0 0 1 0 0 6
  51.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  52.                                           'NULL' ).
  53.       sr  initialize: (gadgetName,'Bdr2') 
  54.            withArray: #( 0 0 2 0 0 6
  55.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  56.                          'tb2' ).
  57. "                         
  58.       gt         <- ((gt bitAnd: 16rF0F0) + 1). "Set BOOLGADGET type."
  59.       f          <- ((f  bitAnd: 16rFFF0) + 2). "Set GADGHIMAGE flag."
  60.       renderName <- gr.
  61.       selectName <- sr.
  62.       
  63.       super initialize: gadgetName 
  64.             withArray:  #(ng le te w h f a gt gr sr txt id)
  65. ]
  66.  
  67. "-----------------------------------------------------"
  68. " TextField Class is a custom look for string gadgets."
  69. "-----------------------------------------------------"
  70.  
  71. Class TextField :StrGadget  ! renderName selectName !
  72. [
  73.    " gadgetValues is an Array with the following fields: 
  74.        NextGadget, LeftEdge, TopEdge, Width, Height, Flags,
  75.        Activation, GadgetType, GadgetText, GadgetID, BufferSize:
  76.    "
  77.    initialize: gadgetName withArray: gadgetValues
  78.       ! ng le te w h f a gt gr sr txt id bs tb1 tb2 !
  79.  
  80.       ng  <- gadgetValues at: 1.
  81.       le  <- gadgetValues at: 2.
  82.       te  <- gadgetValues at: 3.
  83.       w   <- gadgetValues at: 4.
  84.       h   <- gadgetValues at: 5.
  85.       f   <- gadgetValues at: 6.
  86.       a   <- gadgetValues at: 7.
  87.       gt  <- gadgetValues at: 8.
  88.       txt <- gadgetValues at: 9.
  89.       id  <- gadgetValues at: 10.
  90.       bs  <- gadgetValues at: 11.
  91.       gr  <- Border new.
  92.       sr  <- Border new.
  93.       tb1 <- Border new.
  94.       tb2 <- Border new.
  95.  
  96.       tb1 initialize: 'tb1' withArray: #( 0 0 2 0 0 6
  97.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  98.                                           'NULL' ).
  99.       gr  initialize: (gadgetName,'Bdr1') 
  100.            withArray: #( 0 0 1 0 0 6
  101.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  102.                          'tb1' ).
  103.  
  104.       tb2 initialize: 'tb2' withArray: #( 0 0 1 0 0 6
  105.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  106.                                           'NULL' ).
  107.       sr  initialize: (gadgetName,'Bdr2') 
  108.            withArray: #( 0 0 2 0 0 6
  109.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  110.                          'tb2' ).
  111.                          
  112.       ((a bitAnd: 16r0F00) == 16r0800) "Is this an Integer Field?"
  113.          ifFalse: [a <- ((a  bitAnd: 16rF0FF) + 16r200)]. "No, center string."
  114.  
  115.       gt         <- ((gt bitAnd: 16rF0F0) + 4). "Set STRGADGET  type."
  116.       f          <- ((f  bitAnd: 16rFFF0) + 2). "Set GADGHIMAGE flag."
  117.       renderName <- gr.
  118.       selectName <- sr.
  119.       
  120.       super initialize: gadgetName 
  121.             withArray:  #(ng le te w h f a gt gr sr txt id bs)
  122. ]
  123.  
  124. "------------------------------------------------------------"
  125. " VertSlider Class is a custom look for proportional gadgets."
  126. "------------------------------------------------------------"
  127.  
  128. Class VertSlider :PropGadget  ! renderName selectName !
  129. [
  130.    " gadgetValues is an Array with the following fields: 
  131.        NextGadget, LeftEdge, TopEdge, Width, Height, Flags,
  132.        Activation, GadgetType, GadgetText, GadgetID, PropFlags, 
  133.        VertPot, VertBody:
  134.    "
  135.    initialize: gadgetName withArray: gadgetValues
  136.       ! ng le te w h f a gt gr sr txt id pf vp vb tb1 tb2 !
  137.  
  138.       ng  <- gadgetValues at: 1.
  139.       le  <- gadgetValues at: 2.
  140.       te  <- gadgetValues at: 3.
  141.       w   <- gadgetValues at: 4.
  142.       h   <- gadgetValues at: 5.
  143.       f   <- gadgetValues at: 6.
  144.       a   <- gadgetValues at: 7.
  145.       gt  <- gadgetValues at: 8.
  146.       txt <- gadgetValues at: 9.
  147.       id  <- gadgetValues at: 10.
  148.       pf  <- gadgetValues at: 11.
  149.       vp  <- gadgetValues at: 12.
  150.       vb  <- gadgetValues at: 13.
  151.       gr  <- Border new.
  152.       sr  <- Border new.
  153.       tb1 <- Border new.
  154.       tb2 <- Border new.
  155.  
  156.       tb1 initialize: 'tb1' withArray: #( 0 0 2 0 0 6
  157.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  158.                                           'NULL' ).
  159.       gr  initialize: (gadgetName,'Bdr1') 
  160.            withArray: #( 0 0 1 0 0 6
  161.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  162.                          'tb1' ).
  163.  
  164.       tb2 initialize: 'tb2' withArray: #( 0 0 1 0 0 6
  165.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  166.                                           'NULL' ).
  167.       sr  initialize: (gadgetName,'Bdr2') 
  168.            withArray: #( 0 0 2 0 0 6
  169.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  170.                          'tb2' ).
  171.                          
  172.       pf         <- ((pf bitAnd: 16rFFF9) + 4). "Set FREEVERT   flag."
  173.       gt         <- ((gt bitAnd: 16rF0F0) + 3). "Set PROPGADGET type."
  174.       f          <- ((f  bitAnd: 16rFFF0) + 2). "Set GADGHIMAGE flag."
  175.       renderName <- gr.
  176.       selectName <- sr.
  177.       
  178.       super initialize: gadgetName 
  179.             withArray:  #(ng le te w h f a gt gr sr txt id pf 0 vp 0 vb)
  180. |
  181.    setProp: gadgetName flags: newFlags vPot: vp vBody: vb
  182.       newFlags <- ((newFlags bitAnd: 16rFFF9) + 4). "Set FREEVERT flag."
  183.       super setProps: gadgetName flags: newFlags 
  184.                 hPot: 0 vPot: vp hBody: 0 vBody: vb
  185. ]
  186.  
  187. "-------------------------------------------------------------"
  188. " HorizSlider Class is a custom look for proportional gadgets."
  189. "-------------------------------------------------------------"
  190.  
  191. Class HorizSlider :PropGadget  ! renderName selectName !
  192. [
  193.    " gadgetValues is an Array with the following fields: 
  194.        NextGadget, LeftEdge, TopEdge, Width, Height, Flags,
  195.        Activation, GadgetType, GadgetText, GadgetID, PropFlags, 
  196.        HorizPot, HorizBody:
  197.    "
  198.    initialize: gadgetName withArray: gadgetValues
  199.       ! ng le te w h f a gt gr sr txt id pf hp hb tb1 tb2 !
  200.  
  201.       ng  <- gadgetValues at: 1.
  202.       le  <- gadgetValues at: 2.
  203.       te  <- gadgetValues at: 3.
  204.       w   <- gadgetValues at: 4.
  205.       h   <- gadgetValues at: 5.
  206.       f   <- gadgetValues at: 6.
  207.       a   <- gadgetValues at: 7.
  208.       gt  <- gadgetValues at: 8.
  209.       txt <- gadgetValues at: 9.
  210.       id  <- gadgetValues at: 10.
  211.       pf  <- gadgetValues at: 11.
  212.       hp  <- gadgetValues at: 12.
  213.       hb  <- gadgetValues at: 13.
  214.       gr  <- Border new.
  215.       sr  <- Border new.
  216.       tb1 <- Border new.
  217.       tb2 <- Border new.
  218.  
  219.       tb1 initialize: 'tb1' withArray: #( 0 0 2 0 0 6
  220.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  221.                                           'NULL' ).
  222.       gr  initialize: (gadgetName,'Bdr1') 
  223.            withArray: #( 0 0 1 0 0 6
  224.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  225.                          'tb1' ).
  226.  
  227.       tb2 initialize: 'tb2' withArray: #( 0 0 1 0 0 6
  228.                                           (0 h 0 0 w 0 (w-1) 1 1 1 1 (h-1)) 
  229.                                           'NULL' ).
  230.       sr  initialize: (gadgetName,'Bdr2') 
  231.            withArray: #( 0 0 2 0 0 6
  232.                          (w 0 w h 0 h 1 (h-1) (w-1) (h-1) (w-1) 0) 
  233.                          'tb2' ).
  234.                          
  235.       pf         <- ((pf bitAnd: 16rFFF9) + 2). "Set FREEHORIZ  flag."
  236.       gt         <- ((gt bitAnd: 16rF0F0) + 3). "Set PROPGADGET type."
  237.       f          <- ((f  bitAnd: 16rFFF0) + 2). "Set GADGHIMAGE flag."
  238.       renderName <- gr.
  239.       selectName <- sr.
  240.       
  241.       super initialize: gadgetName 
  242.             withArray:  #(ng le te w h f a gt gr sr txt id pf hp 0 hb 0)
  243. |
  244.    setProp: gadgetName flags: newFlags hPot: hp hBody: hb
  245.       newFlags <- ((newFlags bitAnd: 16rFFF9) + 2). "Set FREEHORIZ flag."
  246.       super setProps: gadgetName flags: newFlags 
  247.                 hPot: hp vPot: 0 hBody: hb vBody: 0
  248. ]
  249.